perm filename ASSOC[EKL,SYS] blob
sn#864132 filedate 1988-08-04 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00019 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 functions as association lists
C00007 00003 facts about alists
C00013 00004 PROOFS
C00014 00005 prove sorts
C00019 00006 lemma 3
C00020 00007 lemma 3, expanded proof
C00024 00008 lemma 4
C00028 00009 theorem 1 (i) lemma range compose, part 1
C00032 00010 theorem 1 (i) lemma range compose, part 2
C00037 00011 theorem 1 (i), conclusion.
C00040 00012 theorem 1 (ii)
C00042 00013 samemap left
C00045 00014 theorem 2 (i) (permutp idalistp)
C00046 00015 theorem 2 (ii) (idalistp right)
C00047 00016 theorem 2 (iii) (idalistp left)
C00051 00017 a lemma: the range of a permutation contains only atoms
C00053 00018 theorem 3 (i)
C00056 00019 theorem 3 (ii) and (iii)
C00059 ENDMK
C⊗;
;functions as association lists
(wipe-out)
(get-proofs appl prf ekl sys)
(proof assoc)
(decl (compalist) (infixname: |∞|) (type: |ground⊗ground→ground|)
(syntype: constant) (bindingpower: 930))
(defax compalist |∀alist1 alist2 xa y.nil ∞ alist2=nil∧
((xa.y).alist1) ∞ alist2=(xa.appalist(y,alist2)).(alist1 ∞ alist2)|)
(label compalistdef)
(decl invalist (type: |GROUND→GROUND|))
(defax invalist |∀alist xa y.invalist nil=nil∧
invalist((xa.y).alist)=(y.xa).invalist alist|)
(label invalistdef)
(decl idalistp (type: |GROUND→TRUTHVAL|))
(defax idalistp |∀alist xa y.idalistp(nil)∧
(idalistp((xa.y).alist)≡xa=y∧idalistp alist)|)
(label idalistpdef)
;facts about alists
(proof alistfacts)
;check the sorts
(axiom |∀alist alist1.alistp(alist ∞ alist1)|)
(label compalistsort)(label simpinfo)
(axiom |∀alist.allp(λx.atom x,range(alist))⊃alistp invalist(alist)|)
(label invalistsort)
;facts about composition of functions
;five lemmata
(axiom |∀alist alist1 x.member(x,dom(alist))⊃
appalist(x,alist ∞ alist1)=appalist(appalist(x,alist),alist1)|)
(label alist_lemma1)(label app_compalist)
(axiom |∀alist alist1.dom(alist ∞ alist1)=dom(alist)|)
(label alist_lemma2)(label dom_compalist)
(axiom |∀alist x.member(x,dom alist)⊃
(∃y.member(y,range alist)∧appalist(x,alist)=y)|)
(label alist_lemma3) (label nonempty_range)
(axiom |∀alist z.uniqueness dom(alist)∧member(z,range alist)⊃
(∃x.member(x,dom alist)∧appalist(x,alist)=z)|)
(label alist_lemma4) (label nonempty_domain)
(axiom |∀alist alist1 za z.¬member(za,range(alist))⊃
alist ∞ ((za.z).alist1)=alist ∞ alist1|)
(label compalist_lemma)
;theorem 1: composition of permutations is a permutation
;PERMUTP(ALIST)∧PERMUTP(ALIST1)∧MKLSET(DOM(ALIST))=MKLSET(DOM(ALIST1))⊃
;PERMUTP(ALIST ∞ ALIST1)
;the steps in the proof of Theorem 1 are the following
;lemma range compose
(axiom
|∀alist alist1.permutp(alist)∧permutp(alist1)∧
mklset(dom(alist))=mklset(dom(alist1))⊃
mklset(range(alist ∞ alist1))⊂mklset(range(alist1))|)
(label range_compose)
(axiom
|∀alist alist1.permutp(alist)∧permutp(alist1)∧
mklset(dom(alist))=mklset(dom(alist1))⊃
mklset(range(alist1))⊂mklset(range(alist ∞ alist1))|)
(label range_compose)
;composition is well defined for equivalence classes
(axiom |∀alist alist1 alist2.samemap(alist1,alist2)⊃
alist ∞ alist1=alist ∞ alist2|)
(label samamap_right)
(axiom |∀alist1 alist2.samemap(alist1,alist2)⊃
samemap(alist1 ∞ alist,alist2 ∞ alist)|)
(label samamap_left)
;facts about the identity function
(axiom |∀alist y.idalistp(alist)∧member(y,dom alist)⊃appalist(y,alist)=y|)
(label idalistp_main)
;theorem 2 (i)
;∀ALIST.FUNCTP(ALIST)∧IDALISTP(ALIST)⊃PERMUTP(ALIST)
;theorem 2 (ii)
;IDALISTP(ALIST1)⊃
;(∀ALIST.MKLSET(RANGE(ALIST))⊂MKLSET(DOM(ALIST1))⊃ALIST ∞ ALIST1=ALIST)
;theorem 2 (iii)
;IDALISTP(ALISTID)∧MKLSET(DOM(ALISTID))=MKLSET(DOM(ALIST))⊃
;SAMEMAP(ALISTID ∞ ALIST,ALIST)
;facts about inversion of functions
(axiom |∀alist.allp(λx.atom x,range(alist))⊃dom(invalist(alist))=range(alist)|)
(label dom_invalist)
(axiom |∀alist.allp(λx.atom x,range(alist))⊃range(invalist(alist))=dom(alist)|)
(label range_invalist)
(axiom |∀alist.mklset(dom(alist))=mklset(range(alist))⊃
allp(λx.atom x,range(alist))|)
(label atomrange)
;we borrow this from the proof alpig:
(axiom |∀alist.permutp(alist)⊃injectp(alist)|)
(label permutp_injectp)
;theorem 3 (i)
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
; IDALISTP(ALIST ∞ INVALIST(ALIST))
;theorem 3 (ii)
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
; IDALISTP(INVALIST(ALIST) ∞ ALIST)
;theorem 3 (iii)
;PERMUTP(ALIST)⊃PERMUTP(INVALIST(ALIST))
(save-proofs assoc)
;PROOFS
;prove sorts
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof alistprop)
;compalist sort
(unlabel simpinfo compalistsort)
1. (ue (chi |λalist.alistp(alist ∞ alist1)|) alistinduction
(part 1(open compalist)(use appalistsort mode: exact)))
;∀ALIST.ALISTP ALIST ∞ ALIST1
(label simpinfo compalistsort)
;invalistsort
2. (ue (chi |λalist.allp(λx.atom x,range alist)⊃alistp invalist(alist)|)
alistinduction (open range member invalist)
(use allpfact ue: ((phi.|λx.atom x|)(x.y)(u.|range alist|)) mode: always) )
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))⊃ALISTP INVALIST(ALIST)
;prove facts about composition of functions
;three (of five) lemmata
;lemma 1
3. (ue (chi |λalist.member(x,dom(alist))⊃
appalist(x,alist ∞ alist1)=appalist(appalist(x,alist),alist1)|)
alistinduction
(part 1(use appalistdef mode: always)
(open dom member compalist assoc))
(use normal mode: always))
;∀ALIST.MEMBER(X,DOM(ALIST))⊃
; APPALIST(X,ALIST ∞ ALIST1)=APPALIST(APPALIST(ALIST,X),ALIST1)
;lemma 2
4. (ue (chi |λalist.dom(alist ∞ alist1)=dom(alist)|)
alistinduction
(open compalist dom))
;∀ALIST.DOM(ALIST ∞ ALIST1)=DOM(ALIST)
;compalist lemma
5. (ue (chi |λalist.¬member(za,range alist)⊃alist ∞ ((za.z).alist1)=alist ∞ alist1|)
alistinduction
(open member range compalist appalist assoc) (use demorgan mode: always))
;∀ALIST.¬MEMBER(ZA,RANGE(ALIST))⊃ALIST ∞ ((ZA.Z).ALIST1)=ALIST ∞ ALIST1
;samemap right
6. (ue (chi |λalist.samemap(alist1,alist2)⊃alist ∞ alist1=alist ∞ alist2|)
alistinduction
(part 1(use samemap_def1 mode: exact))
(part 1(open compalist samemap)))
;∀ALIST.SAMEMAP(ALIST1,ALIST2)⊃ALIST ∞ ALIST1=ALIST ∞ ALIST2
;prove a fact about the identity function
;idalistp_main
7. (ue (chi |λalist.idalistp(alist)∧member(y,dom alist)⊃appalist(y,alist)=y|)
alistinduction
(open idalistp appalist assoc member dom) (use normal mode: always))
;∀ALIST.IDALISTP(ALIST)∧MEMBER(Y,DOM(ALIST))⊃CDR ASSOC(Y,ALIST)=Y
;prove facts about inversion of functions
;dom invalist
8. (ue (chi |λalist.allp(λx.atom x,range alist)⊃dom invalist(alist)=range alist|)
alistinduction (open dom range invalist) (use invalistsort)
(use allpfact ue: ((phi.|λx.atom x|)(x.y)(u.|range alist|)) mode: always) )
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))⊃DOM(INVALIST(ALIST))=RANGE(ALIST)
;range invalist
9. (ue (chi |λalist.allp(λx.atom x,range alist)⊃range invalist(alist)=dom alist|)
alistinduction (open dom range invalist) (use invalistsort)
(use allpfact ue: ((phi.|λx.atom x|)(x.y)(u.|range alist|)) mode: always) )
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))⊃RANGE(INVALIST(ALIST))=DOM(ALIST)
;lemma 3
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof nonempty_range)
1. (ue (chi |λalist.member(x,dom alist)⊃somep(λy.appalist(x,alist)=y,range alist)|)
alistinduction
(part 1 (open dom somep range member appalist assoc))
(use normal mode: always))
;∀ALIST.MEMBER(X,DOM(ALIST))⊃SOMEP(λY.APPALIST(X,ALIST)=Y,RANGE(ALIST))
2. (rw * (use somepfact mode: exact))
;∀ALIST.MEMBER(X,DOM(ALIST))⊃
; (∃X1.MEMBER(X1,RANGE(ALIST))∧APPALIST(X,ALIST)=X1)
(show somepfact)
;lemma 3, expanded proof
;should be able to do this in one step
;(ue (chi |λalist.member(x,dom alist)⊃
; (∃y.member(y,range alist)∧appalist(x,alist)=y)|)
; alistinduction
; (use excluded_middle ue:
; ((p.|∃y1.member(y1,range((xa.y).alist))∧appalist(x,(xa.y).alist)=y1|)
; (q.|x=xa|)) normal mode: always)
; (open dom range member appalist assoc))
;LIST STORAGE CAPACITY EXCEEDED
;BKPT GC-LOSSAGE
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof nonempty_range)
1. (assume |MEMBER(X,DOM(ALIST))⊃
(∃Y1.MEMBER(Y1,RANGE(ALIST))∧CDR ASSOC(X,ALIST)=Y1)|)
(label lem31)
2. (assume |member(x,dom((xa.y).alist))|)
(label lem32)
3. (rw * (open dom member))
;X=XA∨MEMBER(X,DOM(ALIST))
(label lem33)
4. (assume |x=xa|)
5. (trw |∃y1.member(y1,range((xa.y).alist))∧appalist(x,(xa.y).alist)=y1|
(open appalist assoc range member) (use * mode: exact))
;∃Y1.MEMBER(Y1,RANGE((XA.Y).ALIST))∧APPALIST(X,(XA.Y).ALIST)=Y1
(label lem34)
6. (assume |x≠xa|)
(label lem35)
7. (derive |member(x,dom(alist))| (lem33 *))
(label lem36)
8. (define yv1 |member(yv1,range(alist))∧cdr assoc(x,alist)=yv1| (lem31 lem36))
(label lem37)
9. (derive |∃y1.member(y1,range((xa.y).alist))∧appalist(x,(xa.y).alist)=y1| *
(open appalist assoc range) (use memberdef lem35 mode: always))
(label lem38)
10. (trw |x=xa∨x≠xa|)
11. (cases * lem34 lem38)
;∃Y1.MEMBER(Y1,RANGE((XA.Y).ALIST))∧APPALIST(X,(XA.Y).ALIST)=Y1
;deps: (LEM31 LEM32)
12. (ci lem32)
;MEMBER(X,DOM((XA.Y).ALIST))⊃
;(∃Y1.MEMBER(Y1,RANGE((XA.Y).ALIST))∧APPALIST(X,(XA.Y).ALIST)=Y1)
;deps: (LEM31)
13. (ci lem31)
14. (ue (chi |λalist.member(x,dom alist)⊃
(∃y.member(y,range alist)∧appalist(x,alist)=y)|)
alistinduction
(use * mode: exact)(part 1#1(open dom member)))
;∀ALIST.MEMBER(X,DOM(ALIST))⊃
; (∃Y.MEMBER(Y,RANGE(ALIST))∧APPALIST(X,ALIST)=Y)
;lemma 4
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof nonempty_domain)
1. (assume |uniqueness dom(alist)∧member(z,range alist)⊃
(∃x.member(x,dom alist)∧appalist(x,alist)=z)|)
(label lem41)
2. (assume |uniqueness dom((xa.y).alist)|)
(label lem42)
3. (rw * (open uniqueness dom))
;¬MEMBER(XA,DOM(ALIST))∧UNIQUENESS(DOM(ALIST))
(label lem43)
;deps: (LEM42)
4. (assume |member(z,range((xa.y).alist))|)
(label lem44)
5. (rw * (open range member))
;Z=Y∨MEMBER(Z,RANGE(ALIST))
(label lem45)
;deps: (LEM44)
6. (assume |z=y|)
7. (trw |∃x1.member(x1,dom((xa.y).alist))∧appalist(x1,(xa.y).alist)=z|
(open dom member appalist assoc) (use * mode: exact))
;∃X1.MEMBER(X1,DOM((XA.Y).ALIST))∧APPALIST(X1,(XA.Y).ALIST)=Z
(label lem46)
8. (assume |member(z,range(alist))|)
(label lem47)
9. (define xxv |member(xxv,dom alist)∧appalist(xxv,alist)=z|(lem41 lem43 lem47))
(label lem48)
10. (derive |xxv≠xa| (lem43 lem48))
;deps: (LEM41 LEM42 LEM47)
11. (trw |appalist(xxv,(xa.y).alist)=z| (open appalist assoc)
(use * mode: exact)(use lem48 mode: always direction: reverse))
;APPALIST(XXV,(XA.Y).ALIST)=Z
;deps: (LEM41 LEM42 LEM47)
12. (derive |∃x1.member(x1,dom((xa.y).alist))∧appalist(x1,(xa.y).alist)=z|
(lem48 *) (open dom) (use memberdef mode: always))
(label lem49)
;deps: (LEM41 LEM42 LEM47)
13. (cases lem45 lem46 lem49)
;∃X1.MEMBER(X1,DOM((XA.Y).ALIST))∧APPALIST(X1,(XA.Y).ALIST)=Z
;deps: (LEM41 LEM42 LEM44)
14. (ci (lem42 lem44))
;UNIQUENESS(DOM((XA.Y).ALIST))∧MEMBER(Z,RANGE((XA.Y).ALIST))⊃
;(∃X1.MEMBER(X1,DOM((XA.Y).ALIST))∧APPALIST(X1,(XA.Y).ALIST)=Z)
;deps: (LEM41)
15. (ci lem41)
16. (ue (chi |λalist.uniqueness dom(alist)∧member(z,range alist)⊃
(∃x.member(x,dom alist)∧appalist(x,alist)=z)|)
alistinduction
(part 1#1(open range member))(use * mode: exact))
;∀ALIST.UNIQUENESS(DOM(ALIST))∧MEMBER(Z,RANGE(ALIST))⊃
; (∃X.MEMBER(X,DOM(ALIST))∧APPALIST(X,ALIST)=Z)
;theorem 1 (i); lemma range compose, part 1
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof range_compose)
1. (assume |permutp(alist)|)
(label rc1)
2. (rw * (open permutp functp))
;UNIQUENESS(DOM(ALIST))∧MKLSET(DOM(ALIST))=MKLSET(RANGE(ALIST))
(label rc2)
3. (assume |mklset dom(alist)=mklset dom(alist1)|)
(label rc3)
4. (assume |member(z,range(alist ∞ alist1))|)
(label rc4)
;apply lemma 4 and lemma 2
5. (ue ((alist.|alist ∞ alist1|)(z.z)) nonempty_domain
(use dom_compalist rc2 rc4 mode: exact) )
;deps: (RC1 RC4)
;∃X.MEMBER(X,DOM(ALIST))∧APPALIST(X,ALIST ∞ ALIST1)=Z
6. (define xxvv |member(xxvv,dom alist)∧appalist(xxvv,alist ∞ alist1)=z| *)
(label rc5)
;deps: (RC1 RC4)
;apply lemma 1
7. (rw * (use app_compalist mode: always))
;MEMBER(XXVV,DOM(ALIST))∧APPALIST(APPALIST(XXVV,ALIST),ALIST1)=Z
(label rc6)
;deps: (RC1 RC4)
;apply lemma 3
8. (define yyvv |member(yyvv,range alist)∧appalist(xxvv,alist)=yyvv|
(nonempty_range rc6))
(label rc7)
;deps: (RC1 RC4)
9. (trw |yyvv ε mklset range(alist)| (open mklset epsilon) rc7)
;YYVVεMKLSET(RANGE(ALIST))
;deps: (RC1 RC4)
10. (rw * (use rc2 mode: exact direction: reverse)
(use rc3 mode: exact))
;YYVVεMKLSET(DOM(ALIST1))
;deps: (RC1 RC3 RC4)
11. (rw * (open epsilon mklset))
;MEMBER(YYVV,DOM(ALIST1))
;deps: (RC1 RC3 RC4)
;apply again lemma 3, this time to alist1
12. (define zzvv |member(zzvv,range alist1)∧appalist(yyvv,alist1)=zzvv|
(nonempty_range *))
(label rc8)
;deps: (RC1 RC3 RC4)
13. (rw rc6 rc7)
;MEMBER(XXVV,DOM(ALIST))∧APPALIST(YYVV,ALIST1)=Z
;deps: (RC1 RC4)
14. (trw |zzvv=z| * (use rc8 mode: always direction: reverse))
;ZZVV=Z
;deps: (RC1 RC3 RC4)
15. (trw |member(z,range alist1)| rc8 (use * mode: exact direction: reverse))
;MEMBER(Z,RANGE(ALIST1))
;deps: (RC1 RC3 RC4)
16. (ci rc4)
;MEMBER(Z,RANGE(ALIST ∞ ALIST1))⊃MEMBER(Z,RANGE(ALIST1))
;deps: (RC1 RC3)
17. (trw |mklset range(alist ∞ alist1)⊂mklset range(alist1)| *
(open mklset inclusion))
;MKLSET(RANGE(ALIST ∞ ALIST1))⊂MKLSET(RANGE(ALIST1))
;deps: (RC1 RC3)
18. (ci (rc1 rc3))
;PERMUTP(ALIST)∧MKLSET(DOM(ALIST))=MKLSET(DOM(ALIST1))⊃
;MKLSET(RANGE(ALIST ∞ ALIST1))⊂MKLSET(RANGE(ALIST1))
;theorem 1 (i); lemma range compose, part 2
(proof range_compose2)
1. (assume |permutp(alist)|)
(label rc21)
2. (rw * (open permutp functp))
;UNIQUENESS(DOM(ALIST))∧MKLSET(DOM(ALIST))=MKLSET(RANGE(ALIST))
(label rc22)
3. (assume |permutp(alist1)|)
(label rc23)
4. (rw * (open permutp functp))
;UNIQUENESS(DOM(ALIST1))∧MKLSET(DOM(ALIST1))=MKLSET(RANGE(ALIST1))
(label rc24)
5. (assume |mklset dom(alist)=mklset dom(alist1)|)
(label rc25)
6. (assume |member(z,range alist1)|)
(label rc26)
;apply lemma 4
7. (define yv1 |member(yv1,dom alist1)∧appalist(yv1,alist1)=z|
(nonempty_domain rc24 rc26))
(label rc27)
;deps: (RC23 RC26)
8. (trw |yv1 ε mklset dom(alist1)| * (open epsilon mklset))
;YV1εMKLSET(DOM(ALIST1))
;deps: (RC23 RC26)
9. (rw * (use rc25 mode: exact direction: reverse)
(use rc22 mode: exact))
;YV1εMKLSET(RANGE(ALIST))
;deps: (RC21 RC23 RC25 RC26)
10. (rw * (open epsilon mklset))
;MEMBER(XV1,RANGE(ALIST))
(label rc28)
;deps: (RC21 RC23 RC25 RC26)
;apply again lemma 4, this time to alist
11. (define xv1 |member(xv1,dom alist)∧appalist(xv1,alist)=yv1|
(nonempty_domain rc22 rc28))
(label rc29)
;deps: (RC21 RC23 RC25 RC26)
;apply lemma 2 and rewrite
12. (trw |member(xv1,dom(alist ∞ alist1))| * (use dom_compalist))
;MEMBER(XV1,DOM(ALIST ∞ ALIST1))
(label rc30)
;deps: (RC21 RC23 RC25 RC26)
13. (trw |appalist(xv1,alist ∞ alist1)| rc29 rc30
(use app_compalist rc29 rc27 mode: always))
;APPALIST(XV1,ALIST ∞ ALIST1)=Z
(label rc31)
;deps: (RC21 RC23 RC25 RC26)
;apply lemma 3
14. (ue ((alist.|alist ∞ alist1|)(x.xv1)) nonempty_range
(use dom_compalist rc22 rc30 mode: always))
;∃Y.MEMBER(Y,RANGE(ALIST ∞ ALIST1))∧APPALIST(XV1,ALIST ∞ ALIST1)=Y
;deps: (RC21 RC23 RC25 RC26)
15. (define zv1
|member(zv1,range(alist ∞ alist1))∧appalist(xv1,alist ∞ alist1)=zv1| *)
(label rc32)
;deps: (RC21 RC23 RC25 RC26)
16. (trw |zv1=z| rc31 (use * mode: always direction: reverse))
;ZV1=Z
;deps: (RC21 RC23 RC25 RC26)
17. (trw |member(z,range(alist ∞ alist1))| rc32
(use * mode: exact direction: reverse))
;MEMBER(Z,RANGE(ALIST ∞ ALIST1))
;deps: (RC21 RC23 RC25 RC26)
18. (ci rc26)
;MEMBER(Z,RANGE(ALIST1))⊃MEMBER(Z,RANGE(ALIST ∞ ALIST1))
;deps: (RC21 RC23 RC25)
19. (trw |mklset range(alist1)⊂mklset range(alist ∞ alist1)| *
(open inclusion mklset) )
;MKLSET(RANGE(ALIST1))⊂MKLSET(RANGE(ALIST ∞ ALIST1))
;deps: (RC21 RC23 RC25)
20. (ci (rc21 rc23 rc25))
;PERMUTP(ALIST)∧PERMUTP(ALIST1)∧MKLSET(DOM(ALIST))=MKLSET(DOM(ALIST1))⊃
;MKLSET(RANGE(ALIST1))⊂MKLSET(RANGE(ALIST ∞ ALIST1))
;theorem 1 (i), conclusion.
(proof permutp_compalist)
1. (assume |permutp(alist)|)
(label permut_comp1)
2. (assume |permutp(alist1)|)
(label permut_comp2)
3. (assume |mklset(dom(alist))=mklset(dom(alist1))|)
(label permut_comp3)
4. (derive |mklset(range(alist ∞ alist1))⊂mklset(range(alist1))∧
mklset(range(alist1))⊂mklset(range(alist ∞ alist1))|
(permut_comp1 permut_comp2 permut_comp3 range_compose))
;deps: (PERMUT_COMP1 PERMUT_COMP2 PERMUT_COMP3)
5. (derive |mklset(range(alist ∞ alist1))=mklset(range(alist1))|
(* double_inclusion))
;deps: (PERMUT_COMP1 PERMUT_COMP2 PERMUT_COMP3)
(label permut_comp4)
6. (rw permut_comp1 (open permutp functp))
;UNIQUENESS(DOM(ALIST))∧MKLSET(DOM(ALIST))=MKLSET(RANGE(ALIST))
(label permut_comp5)
7. (rw permut_comp2 (open permutp))
;FUNCTP(ALIST1)∧MKLSET(DOM(ALIST1))=MKLSET(RANGE(ALIST1))
8. (trw |uniqueness(dom(alist ∞ alist1))∧
mklset dom(alist ∞ alist1)=mklset range(alist ∞ alist1)|
(use dom_compalist permut_comp4 mode: exact) permut_comp5
(use * permut_comp3 mode: always direction: reverse))
;UNIQUENESS(DOM(ALIST ∞ ALIST1))∧
;MKLSET(DOM(ALIST ∞ ALIST1))=MKLSET(RANGE(ALIST ∞ ALIST1))
;deps: (PERMUT_COMP1 PERMUT_COMP2 PERMUT_COMP3)
9. (trw |permutp(alist ∞ alist1)| * (open permutp functp))
;PERMUTP(ALIST ∞ ALIST1)
;deps: (PERMUT_COMP1 PERMUT_COMP2 PERMUT_COMP3)
10. (ci (permut_comp1 permut_comp2 permut_comp3))
;PERMUTP(ALIST)∧PERMUTP(ALIST1)∧MKLSET(DOM(ALIST))=MKLSET(DOM(ALIST1))⊃
;PERMUTP(ALIST ∞ ALIST1)
;theorem 1 (ii)
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof compalist_associativity)
1. (trw |mklset(range((xa.y).alist))⊂mklset(dom alist1)⊃
member(y,dom alist1)∧mklset range(alist)⊂mklset dom(alist1)|
(open mklset inclusion range member)(use normal mode: always))
;MKLSET(RANGE((XA.Y).ALIST))⊂MKLSET(DOM(ALIST1))⊃
;MEMBER(Y,DOM(ALIST1))∧MKLSET(RANGE(ALIST))⊂MKLSET(DOM(ALIST1))
2. (trw |member(y,dom alist1)∧mklset range(alist)⊂mklset dom(alist1)⊃
mklset(range((xa.y).alist))⊂mklset(dom alist1)| (der)
(open mklset inclusion range member)(use normal mode: always))
3. (derive |mklset(range((xa.y).alist))⊂mklset(dom alist1)≡
member(y,dom alist1)∧mklset range(alist)⊂mklset dom(alist1)| (* -2))
(label helpinduction)
4. (ue (chi |λalist.mklset(range alist)⊂mklset(dom alist1)⊃
alist ∞ (alist1 ∞ alist2)=(alist ∞ alist1) ∞ alist2|)
alistinduction
(part 1(open compalist)(use app_compalist * mode: always)))
;∀ALIST.MKLSET(RANGE(ALIST))⊂MKLSET(DOM(ALIST1))⊃
; ALIST ∞ (ALIST1 ∞ ALIST2)=(ALIST ∞ ALIST1) ∞ ALIST2
;samemap left
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof samemap_left)
1. (assume |samemap(alist1,alist2)|)
(label sml1)
2. (rw * (open samemap))
;MKLSET(DOM(ALIST1))=MKLSET(DOM(ALIST2))∧
;(∀Y.YεMKLSET(DOM(ALIST1))⊃APPALIST(Y,ALIST1)=APPALIST(Y,ALIST2))
(label sml2)
3. (assume |yεmklset dom(alist1)|)
(label sml3)
4. (derive |appalist(y,alist1)=appalist(y,alist2)| (sml2 sml3))
(label sml4)
5. (rw sml3 (use sml2 mode: exact))
;YεMKLSET(DOM(ALIST2))
(label sml5)
6. (rw sml3 (open epsilon mklset))
;MEMBER(Y,DOM(ALIST1))
7. (rw sml5 (open epsilon mklset))
;MEMBER(Y,DOM(ALIST2))
8. (trw |appalist(y,alist1 ∞ alist)=appalist(y,alist2 ∞ alist)|
(use app_compalist -2 mode: exact)
(use app_compalist * mode: exact)
(use sml4 mode: exact))
;APPALIST(Y,ALIST1 ∞ ALIST)=APPALIST(Y,ALIST2 ∞ ALIST)
;deps: (SML1 SML3)
9. (ci sml3)
;YεMKLSET(DOM(ALIST1))⊃APPALIST(Y,ALIST1 ∞ ALIST)=APPALIST(Y,ALIST2 ∞ ALIST)
10. (trw |mklset(dom(alist1 ∞ alist))=mklset(dom(alist2 ∞ alist))|
dom_compalist (use sml2 mode: exact))
;MKLSET(DOM(ALIST1 ∞ ALIST))=MKLSET(DOM(ALIST2 ∞ ALIST))
11. (trw |samemap(alist1 ∞ alist,alist2 ∞ alist)| (open samemap)
(dom_compalist * -2))
;SAMEMAP(ALIST1 ∞ ALIST,ALIST2 ∞ ALIST)
;deps: (SML1)
12. (ci sml1)
;SAMEMAP(ALIST1,ALIST2)⊃SAMEMAP(ALIST1 ∞ ALIST,ALIST2 ∞ ALIST)
;theorem 2 (i) (permutp idalistp)
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof idalistprop)
1. (ue (chi |λalist.idalistp(alist)⊃dom alist=range alist|) alistinduction
(open idalistp dom range))
;∀ALIST.IDALISTP(ALIST)⊃DOM(ALIST)=RANGE(ALIST)
2. (trw |∀alist.functp(alist)∧idalistp(alist)⊃permutp(alist)|
(open functp permutp)(use * mode: always))
;∀ALIST.FUNCTP(ALIST)∧IDALISTP(ALIST)⊃PERMUTP(ALIST)
;theorem 2 (ii) (idalistp right)
3. (assume |idalistp(alist1)|)
4. (ue (chi |λalist.mklset(range(alist))⊂mklset(dom(alist1))⊃
(alist ∞ alist1=alist)|)
alistinduction
(part 1(open compalist))
(use helpinduction idalistp_main * mode: always))
;∀ALIST.MKLSET(RANGE(ALIST))⊂MKLSET(DOM(ALIST1))⊃ALIST ∞ ALIST1=ALIST
;deps: (4)
5. (ci -2)
;IDALISTP(ALIST1)⊃
;(∀ALIST.MKLSET(RANGE(ALIST))⊂MKLSET(DOM(ALIST1))⊃ALIST ∞ ALIST1=ALIST)
;theorem 2 (iii) (idalistp left)
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof idalistp_left)
1. (assume |idalistp alistid|)
(label idal_l1)
;ALISTID is unknown.
;the symbol ALISTID is given the same declaration as ALIST
2. (assume |mklset dom(alistid)=mklset dom(alist)|)
(label idal_l2)
3. (assume |yεmklset(dom(alistid ∞ alist))|)
(label idal_l3)
4. (rw * (use dom_compalist mode: exact)(open epsilon mklset))
(label idal_l4)
;MEMBER(Y,DOM(ALISTID))
;deps: (idal_l3)
5. (trw |appalist(y,alistid ∞ alist)| (use app_compalist * mode: exact))
;APPALIST(Y,ALISTID ∞ ALIST)=APPALIST(APPALIST(Y,ALISTID),ALIST)
(label idal_l5)
;labels: IDALISTP_MAIN
; (AXIOM
; |∀ALIST Y.IDALISTP(ALIST)∧MEMBER(Y,DOM(ALIST))⊃APPALIST(Y,ALIST)=Y|)
6. (derive |appalist(y,alistid)=y| (idalistp_main idal_l1 idal_l4))
;deps: (idal_l1 idal_l3)
7. (rw idal_l5 *)
;APPALIST(Y,ALISTID ∞ ALIST)=APPALIST(Y,ALIST)
;deps: (idal_l1 idal_l3)
8. (ci idal_l3)
;YεMKLSET(DOM(ALISTID ∞ ALIST))⊃APPALIST(Y,ALISTID ∞ ALIST)=APPALIST(Y,ALIST)
(label idal_l6)
;deps: (idal_l1)
9. (trw |mklset(dom(alistid ∞ alist))=mklset dom(alist)|
(use dom_compalist idal_l2 mode: exact))
;MKLSET(DOM(ALISTID ∞ ALIST))=MKLSET(DOM(ALIST))
;deps: (idal_l2)
;labels: SAMEMAPDEF
; (DEFINE SAMEMAP
; |∀ALIST ALIST1.SAMEMAP(ALIST,ALIST1)≡
; MKLSET(DOM(ALIST))=MKLSET(DOM(ALIST1))∧
; (∀Y.YεMKLSET(DOM(ALIST))⊃
; APPALIST(Y,ALIST)=APPALIST(Y,ALIST1))| NIL)
10. (trw |samemap(alistid ∞ alist,alist)| (open samemap) (idal_l6 *))
;SAMEMAP(ALISTID ∞ ALIST,ALIST)
;deps: (idal_l1 idal_l2)
11. (ci (idal_l1 idal_l2))
;IDALISTP(ALISTID)∧MKLSET(DOM(ALISTID))=MKLSET(DOM(ALIST))⊃
;SAMEMAP(ALISTID ∞ ALIST,ALIST)
;a lemma: the range of a permutation contains only atoms
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof atomrange)
1. (assume |mklset(dom(alist))=mklset(range(alist))|)
(label ar1)
2. (ue (chi |λalist.allp(λx.atom(x),dom alist)|)
alistinduction
(open allp dom))
;∀ALIST.ALLP(λX.ATOM X,DOM(ALIST))
(label ar2)
3. (ue ((phi1.|λx.atom(x)|)(x.x)(u.|dom alist|)) allp_elimination *)
;MEMBER(X,DOM(ALIST))⊃ATOM X
4. (trw |mklset dom(alist)⊂(λx.atom x)| * (open inclusion mklset) )
;MKLSET(DOM(ALIST))⊂(λX.ATOM X)
5. (rw * (use ar1 mode: exact))
;MKLSET(RANGE(ALIST))⊂(λX.ATOM X)
6. (rw * (open inclusion mklset))
;∀XV.MEMBER(XV,RANGE(ALIST))⊃ATOM XV
7. (ue ((phi1.|λx.atom x|)(u.|range alist|))
allp_introduction *)
;ALLP(λX.ATOM X,RANGE(ALIST))
8. (ci ar1)
;MKLSET(DOM(ALIST))=MKLSET(RANGE(ALIST))⊃ALLP(λX.ATOM X,RANGE(ALIST))
(label atomrange)
;theorem 3 (i)
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof permutp_invalist)
;we borrow this result from the proof permutp_injectp
0. (axiom |∀alist.permutp alist⊃injectp alist|)
(label permutp_injectp)
(proof permutp_invalist)
1. (assume |permutp alist|)
(label piv1)
2. (derive |injectp alist|(permutp_injectp piv1))
;deps: (PIV1)
3. (rw * (open injectp))
;FUNCTP(ALIST)∧UNIQUENESS(RANGE(ALIST))
(label piv2)
4. (rw piv1 (open permutp))
;FUNCTP(ALIST)∧MKLSET(DOM(ALIST))=MKLSET(RANGE(ALIST))
(label piv3)
5. (derive |allp(λx.atom x,range alist)| (atomrange *))
(label piv4)
6. (derive |dom invalist(alist)=range alist| (dom_invalist *))
(label piv5)
7. (derive |range invalist(alist)=dom alist| (range_invalist piv4))
(label piv6)
8. (trw |uniqueness dom(invalist(alist))| piv2 (use piv5))
;UNIQUENESS(DOM(INVALIST(ALIST)))
(label piv7)
9. (trw |mklset dom(invalist(alist))=mklset range(invalist(alist))|
piv3 (use piv5 piv6))
;MKLSET(DOM(INVALIST(ALIST)))=MKLSET(RANGE(INVALIST(ALIST)))
(label piv8)
10. (trw |permutp invalist(alist)| piv7 piv8
(open permutp functp) (use invalistsort piv4 mode: exact))
;PERMUTP(INVALIST(ALIST))
;deps: (PIV1)
11. (ci piv1)
;PERMUTP(ALIST)⊃PERMUTP(INVALIST(ALIST))
(label permutp_invalist)
;theorem 3 (ii) and (iii)
(wipe-out)
(get-proofs assoc prf ekl sys)
(proof invalistprop)
1. (ue (chi |λALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
IDALISTP(ALIST ∞ INVALIST(ALIST))|) alistinduction
(part 1(use allpfact ue: ((phi.|λx.atom x|)(x.y)(u.|range alist|)) )
(open range injectp functp uniqueness invalist
idalistp compalist appalist assoc)
(use invalistsort dom_invalist compalist_lemma mode: exact)))
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
; IDALISTP(ALIST∞INVALIST(ALIST))
;theorem 3 (ii)
2. (assume |ALLP(λX.ATOM X,RANGE(ALIST))|)
3. (ue ((alist.|invalist(alist)|)(alist1.|alist|)(za.xa)(z.y)) compalist_lemma
(use * invalistsort range_invalist mode: exact))
;¬MEMBER(XA,DOM(ALIST))⊃INVALIST(ALIST) ∞ ((XA.Y).ALIST)=INVALIST(ALIST) ∞ ALIST
4. (ci -2)
;ALLP(λX.ATOM X,RANGE(ALIST))⊃
;(¬MEMBER(XA,DOM(ALIST))⊃INVALIST(ALIST) ∞ ((XA.Y).ALIST)=INVALIST(ALIST) ∞ ALIST)
5. (ue (chi |λALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
IDALISTP(INVALIST(ALIST) ∞ ALIST)|) alistinduction
(part 1 (open allp range injectp functp uniqueness
invalist compalist appalist assoc idalistp)
invalistsort (use range_invalist mode: exact) (use * mode: always)))
;∀ALIST.ALLP(λX.ATOM X,RANGE(ALIST))∧INJECTP(ALIST)⊃
; IDALISTP(INVALIST(ALIST) ∞ ALIST)